VERSION 5.00
Begin VB.UserControl flatButton 
   CanGetFocus     =   0   'False
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   240
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   320
   ToolboxBitmap   =   "flatButton.ctx":0000
End
Attribute VB_Name = "flatButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Public Event Click()

Private mCaption As String
Private mCaptionLen As Long
Private mRect As RECT
Private mShowUpBeforeEvent As Boolean
Private Downed As Boolean
Private mChecked As Boolean
Private Enum ButtonStat
    Shown_Down
    Shown_Null
    Shown_Up
End Enum
Dim bs As ButtonStat
Public AlwaysShowUp As Boolean

Public Property Get Font() As Font
    Set Font = UserControl.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set UserControl.Font = New_Font
    PropertyChanged "Font"
End Property

Public Property Let Caption(ByVal NewCaption As String)
mCaption = NewCaption
mCaptionLen = LenB(StrConv(mCaption, vbFromUnicode))
ShowNull
End Property

Public Property Get Caption() As String
Caption = mCaption
End Property

Public Property Let ShowUpBeforeEvent(ByVal newShowUpBeforeEvent As Boolean)
mShowUpBeforeEvent = newShowUpBeforeEvent
End Property

Public Property Get ShowUpBeforeEvent() As Boolean
ShowUpBeforeEvent = mShowUpBeforeEvent
End Property

'-----------
Private Sub UserControl_Resize()
With mRect
    .Right = ScaleWidth
    .Bottom = ScaleHeight
End With
End Sub

Private Sub UserControl_Paint()
If Checked Then
    bs = Shown_Null
    ShowDown
Else
    ShowNull
End If
End Sub

Private Sub UserControl_InitProperties()
Set UserControl.Font = Ambient.Font
Caption = Extender.Name
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
Caption = PropBag.ReadProperty("Caption", Extender.Name)
mShowUpBeforeEvent = PropBag.ReadProperty("ShowUpBeforeEvent", False)
AlwaysShowUp = PropBag.ReadProperty("AlwaysShowUp", False)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "Font", UserControl.Font, Ambient.Font
PropBag.WriteProperty "Caption", mCaption, Extender.Name
PropBag.WriteProperty "ShowUpBeforeEvent", mShowUpBeforeEvent, False
PropBag.WriteProperty "AlwaysShowUp", AlwaysShowUp, False
End Sub

Private Sub ShowUp()
If mChecked Then Exit Sub
If bs = Shown_Up Then Exit Sub
ShowNull
bs = Shown_Up
DrawEdge UserControl.hDC, mRect, CLng(BDR_RAISEDINNER Or BF_SOFT), BF_RECT
End Sub

Private Sub ShowDown()
If bs = Shown_Down Then Exit Sub
bs = Shown_Down
Dim r As RECT
With r
    .Right = ScaleWidth + 2
    .Bottom = ScaleHeight + 2
End With
UserControl.Cls
DrawText UserControl.hDC, mCaption, mCaptionLen, r, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
DrawEdge UserControl.hDC, mRect, CLng(BDR_SUNKENOUTER Or BF_SOFT), BF_RECT
End Sub

Private Sub ShowNull()
'If bs = Shown_Null Then Exit Sub
If mChecked Then Exit Sub
bs = Shown_Null
Dim r As RECT
With r
    .Right = ScaleWidth
    .Bottom = ScaleHeight
End With
UserControl.Cls
If AlwaysShowUp Then
    DrawEdge UserControl.hDC, mRect, CLng(BDR_RAISEDINNER Or BF_SOFT), BF_RECT
End If
DrawText UserControl.hDC, mCaption, mCaptionLen, r, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
'TextOut UserControl.hDC, d
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Downed = True
ShowDown
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X < 0 Or Y < 0 Or X > ScaleWidth Or Y > ScaleHeight Then
    If Downed Then
        ShowUp
    Else
        ReleaseCapture
        ShowNull
    End If
    
Else
    If Downed Then
        ShowDown
    Else
        SetCapture UserControl.hWnd
        ShowUp
    End If
End If
End Sub

Private Sub UserControl_DblClick()
ShowDown
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'
ReleaseCapture
If mShowUpBeforeEvent Then ShowNull
If X >= 0 And Y >= 0 And X <= ScaleWidth And Y <= ScaleHeight Then RaiseEvent Click
ShowNull
Downed = False
End Sub

Private Sub UserControl_Click()
'
End Sub

Public Property Get Checked() As Boolean
Checked = mChecked
End Property

Public Property Let Checked(ByVal NewChecked As Boolean)
mChecked = NewChecked
If Checked Then ShowDown Else ShowNull
End Property

Public Property Get hWnd() As Long
hWnd = UserControl.hWnd
End Property
